﻿namespace Lilium.LParse

type HistoryParser<'symbol, 'witness> =
    abstract member Parse<'history, 'result> :
        ('history * 'witness -> State<'symbol> -> Step<'result>) 
        -> 'history                                               
        -> State<'symbol>
        -> Step<'result>

module HistoryParser =

    open Lilium.LParse.Prelude
    open Lilium.LParse.Step

    let parse<'symbol, 'witness, 'history> (parser : HistoryParser<'symbol, 'witness>) state =
        let step = parser.Parse (fun result state -> if state.Eof then success result else fail)
                                Unchecked.defaultof<'history> 
                                state 
        step.Eval ()

    let satisfy p = 
        { new HistoryParser<'symbol, 'symbol> with 
            member x.Parse cont history state = 
                match state.Split p with
                | Some (symbol, newState) -> step (cont (history, symbol) newState )
                | None -> fail }

    // category

    let compose (p1 : HistoryParser<'symbol, ('witness1 -> 'witness2)>) (p2 : HistoryParser<'symbol, 'witness1>) = 
        { new HistoryParser<'symbol, 'witness2> with 
            member x.Parse cont h s = 
                let applyh = fun ((h, b2a), b) -> cont (h, b2a b)
                p1.Parse (p2.Parse applyh) h s }

    // functor

    let apply f (p : HistoryParser<'symbol, 'witness>) =
        { new HistoryParser<'symbol, 'witness1> with
            member x.Parse cont h s = 
                p.Parse (fun (h, a) -> cont (h, f a)) h s }
